home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / CollWiz.frm < prev    next >
Text File  |  1997-06-14  |  20KB  |  596 lines
  1. VERSION 5.00
  2. Begin VB.Form FCollectionWizard 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Collection Wizard"
  5.    ClientHeight    =   6330
  6.    ClientLeft      =   390
  7.    ClientTop       =   765
  8.    ClientWidth     =   6615
  9.    BeginProperty Font 
  10.       Name            =   "MS Sans Serif"
  11.       Size            =   8.25
  12.       Charset         =   0
  13.       Weight          =   700
  14.       Underline       =   0   'False
  15.       Italic          =   0   'False
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    Icon            =   "CollWiz.frx":0000
  19.    LinkTopic       =   "Form1"
  20.    MaxButton       =   0   'False
  21.    MinButton       =   0   'False
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   6330
  24.    ScaleWidth      =   6615
  25.    Begin VB.ComboBox cboView 
  26.       Height          =   315
  27.       ItemData        =   "CollWiz.frx":0CFA
  28.       Left            =   4200
  29.       List            =   "CollWiz.frx":0D04
  30.       Style           =   2  'Dropdown List
  31.       TabIndex        =   24
  32.       Top             =   1320
  33.       Width           =   2295
  34.    End
  35.    Begin VB.CommandButton cmdView 
  36.       Caption         =   "View Class"
  37.       Default         =   -1  'True
  38.       Height          =   375
  39.       Left            =   4200
  40.       TabIndex        =   22
  41.       Top             =   120
  42.       Width           =   2292
  43.    End
  44.    Begin VB.CheckBox chkWalkPublic 
  45.       Caption         =   "Make walker public"
  46.       Height          =   252
  47.       Left            =   4200
  48.       TabIndex        =   20
  49.       Top             =   1920
  50.       Width           =   2172
  51.    End
  52.    Begin VB.OptionButton optContainer 
  53.       Caption         =   "Object container"
  54.       Height          =   252
  55.       Index           =   2
  56.       Left            =   4200
  57.       TabIndex        =   19
  58.       Top             =   2760
  59.       Width           =   2172
  60.    End
  61.    Begin VB.OptionButton optContainer 
  62.       Caption         =   "Variable container"
  63.       Height          =   252
  64.       Index           =   1
  65.       Left            =   4200
  66.       TabIndex        =   18
  67.       Top             =   2520
  68.       Width           =   2172
  69.    End
  70.    Begin VB.OptionButton optContainer 
  71.       Caption         =   "Generic container"
  72.       Height          =   252
  73.       Index           =   0
  74.       Left            =   4200
  75.       TabIndex        =   17
  76.       Top             =   2280
  77.       Value           =   -1  'True
  78.       Width           =   2172
  79.    End
  80.    Begin VB.CheckBox chkCollPublic 
  81.       Caption         =   "Make collection public"
  82.       Height          =   252
  83.       Left            =   4200
  84.       TabIndex        =   16
  85.       Top             =   1680
  86.       Value           =   1  'Checked
  87.       Width           =   2295
  88.    End
  89.    Begin VB.TextBox txtBase 
  90.       Height          =   375
  91.       Left            =   120
  92.       TabIndex        =   14
  93.       Top             =   480
  94.       Width           =   1932
  95.    End
  96.    Begin VB.TextBox txtWalkFile 
  97.       Height          =   375
  98.       Left            =   2160
  99.       TabIndex        =   10
  100.       Top             =   2685
  101.       Width           =   1932
  102.    End
  103.    Begin VB.TextBox txtWalkVar 
  104.       Height          =   375
  105.       Left            =   2160
  106.       TabIndex        =   9
  107.       Top             =   1965
  108.       Width           =   1932
  109.    End
  110.    Begin VB.TextBox txtWalkClass 
  111.       Height          =   375
  112.       Left            =   2160
  113.       TabIndex        =   8
  114.       Top             =   1245
  115.       Width           =   1932
  116.    End
  117.    Begin VB.TextBox txtCollClass 
  118.       Height          =   375
  119.       Left            =   120
  120.       TabIndex        =   4
  121.       Top             =   1245
  122.       Width           =   1932
  123.    End
  124.    Begin VB.TextBox txtCollVar 
  125.       Height          =   375
  126.       Left            =   120
  127.       TabIndex        =   3
  128.       Top             =   1965
  129.       Width           =   1932
  130.    End
  131.    Begin VB.TextBox txtCollFile 
  132.       Height          =   375
  133.       Left            =   120
  134.       TabIndex        =   2
  135.       Top             =   2685
  136.       Width           =   1932
  137.    End
  138.    Begin VB.CommandButton cmdFile 
  139.       Caption         =   "&Save Class Files"
  140.       Enabled         =   0   'False
  141.       Height          =   375
  142.       Left            =   4200
  143.       TabIndex        =   1
  144.       Top             =   600
  145.       Width           =   2292
  146.    End
  147.    Begin VB.TextBox txtCode 
  148.       BeginProperty Font 
  149.          Name            =   "Courier New"
  150.          Size            =   9.75
  151.          Charset         =   0
  152.          Weight          =   700
  153.          Underline       =   0   'False
  154.          Italic          =   0   'False
  155.          Strikethrough   =   0   'False
  156.       EndProperty
  157.       Height          =   2988
  158.       Left            =   120
  159.       MultiLine       =   -1  'True
  160.       ScrollBars      =   3  'Both
  161.       TabIndex        =   0
  162.       Top             =   3120
  163.       Width           =   6372
  164.    End
  165.    Begin VB.Label lblStatus 
  166.       Height          =   255
  167.       Left            =   120
  168.       TabIndex        =   23
  169.       Top             =   6120
  170.       Width           =   5415
  171.    End
  172.    Begin VB.Label lbl 
  173.       Caption         =   "View:"
  174.       Height          =   255
  175.       Index           =   7
  176.       Left            =   4200
  177.       TabIndex        =   21
  178.       Top             =   1080
  179.       Width           =   1335
  180.    End
  181.    Begin VB.Label lbl 
  182.       Caption         =   "Base name (blob for CBlobs collection)"
  183.       Height          =   255
  184.       Index           =   6
  185.       Left            =   120
  186.       TabIndex        =   15
  187.       Top             =   240
  188.       Width           =   3855
  189.    End
  190.    Begin VB.Label lbl 
  191.       Caption         =   "Walker filename:"
  192.       Height          =   255
  193.       Index           =   5
  194.       Left            =   2160
  195.       TabIndex        =   13
  196.       Top             =   2400
  197.       Width           =   1575
  198.    End
  199.    Begin VB.Label lbl 
  200.       Caption         =   "Walker variable:"
  201.       Height          =   255
  202.       Index           =   4
  203.       Left            =   2160
  204.       TabIndex        =   12
  205.       Top             =   1680
  206.       Width           =   1815
  207.    End
  208.    Begin VB.Label lbl 
  209.       Caption         =   "Walker class name:"
  210.       Height          =   255
  211.       Index           =   0
  212.       Left            =   2160
  213.       TabIndex        =   11
  214.       Top             =   960
  215.       Width           =   2055
  216.    End
  217.    Begin VB.Label lbl 
  218.       Caption         =   "Collection class name:"
  219.       Height          =   255
  220.       Index           =   1
  221.       Left            =   120
  222.       TabIndex        =   7
  223.       Top             =   960
  224.       Width           =   2055
  225.    End
  226.    Begin VB.Label lbl 
  227.       Caption         =   "Collection variable:"
  228.       Height          =   255
  229.       Index           =   2
  230.       Left            =   120
  231.       TabIndex        =   6
  232.       Top             =   1680
  233.       Width           =   2295
  234.    End
  235.    Begin VB.Label lbl 
  236.       Caption         =   "Collection filename:"
  237.       Height          =   255
  238.       Index           =   3
  239.       Left            =   120
  240.       TabIndex        =   5
  241.       Top             =   2400
  242.       Width           =   1815
  243.    End
  244. End
  245. Attribute VB_Name = "FCollectionWizard"
  246. Attribute VB_GlobalNameSpace = False
  247. Attribute VB_Creatable = False
  248. Attribute VB_PredeclaredId = True
  249. Attribute VB_Exposed = False
  250. Option Explicit
  251.  
  252. Enum EClassType
  253.     ectCollection
  254.     ectWalker
  255. End Enum
  256.  
  257. Enum EContainer
  258.     ecGeneric
  259.     ecVariable
  260.     ecObject
  261. End Enum
  262.  
  263. Private Sub cboView_Click()
  264.     CreateView
  265. End Sub
  266.  
  267. Private Sub cmdView_Click()
  268.     Dim s As String
  269.     If cmdView.Caption = "View Class" Then
  270.         If txtBase <> sEmpty Then
  271.             cmdView.Caption = "Clear All"
  272.             cmdFile.Enabled = True
  273.             s = Left$(txtBase, 1)
  274.             s = UCase$(s) & Mid$(txtBase, 2)
  275.             If txtCollClass = sEmpty Then
  276.                 txtCollClass = "C" & s & "s"
  277.             End If
  278.             If txtCollVar = sEmpty Then
  279.                 txtCollVar = txtBase & "s"
  280.             End If
  281.             If txtCollFile = sEmpty Then
  282.                 txtCollFile = UCase$(s) & "S" & ".CLS"
  283.             End If
  284.             If txtWalkClass = sEmpty Then
  285.                 txtWalkClass = "C" & s & "Walker"
  286.             End If
  287.             If txtWalkVar = sEmpty Then
  288.                 txtWalkVar = txtBase
  289.             End If
  290.             If txtWalkFile = sEmpty Then
  291.                 txtWalkFile = UCase$(s) & "WLK" & ".CLS"
  292.             End If
  293.         End If
  294.         CreateView
  295.     Else
  296.         cmdView.Caption = "View Class"
  297.         cmdFile.Enabled = False
  298.         txtBase = sEmpty
  299.         txtCollClass = sEmpty
  300.         txtCollVar = sEmpty
  301.         txtCollFile = sEmpty
  302.         txtWalkClass = sEmpty
  303.         txtWalkVar = sEmpty
  304.         txtWalkFile = sEmpty
  305.         txtCode = sEmpty
  306.         lblStatus = sEmpty
  307.     End If
  308. End Sub
  309.  
  310. Private Sub Form_Load()
  311.     Show
  312.     cboView.ListIndex = ectCollection
  313.     txtBase.SetFocus
  314. End Sub
  315.  
  316. Private Sub chkCollPublic_Click()
  317.     If chkCollPublic Then
  318.         chkWalkPublic.Enabled = True
  319.     Else
  320.         chkWalkPublic = False
  321.         chkWalkPublic.Enabled = False
  322.     End If
  323.     CreateView
  324. End Sub
  325.  
  326. Private Sub chkWalkPublic_Click()
  327.     CreateView
  328. End Sub
  329.  
  330. Private Sub txtCollClass_LostFocus()
  331.     CreateView
  332. End Sub
  333.  
  334. Private Sub txtCollFile_LostFocus()
  335.     CreateView
  336. End Sub
  337.  
  338. Private Sub txtCollVar_LostFocus()
  339.     CreateView
  340. End Sub
  341.  
  342. Private Sub txtWalkClass_LostFocus()
  343.     CreateView
  344. End Sub
  345.  
  346. Private Sub txtWalkFile_LostFocus()
  347.     CreateView
  348. End Sub
  349.  
  350. Private Sub txtWalkVar_LostFocus()
  351.     CreateView
  352. End Sub
  353.  
  354. Private Sub optContainer_Click(Index As Integer)
  355.     CreateView
  356. End Sub
  357.  
  358. Sub CreateView()
  359.     If txtBase = sEmpty Then
  360.         lblStatus = "Must give base name"
  361.         txtBase.SetFocus
  362.         Exit Sub
  363.     End If
  364.     lblStatus = sEmpty
  365.     If cboView.ListIndex = ectCollection Then
  366.         txtCode.Text = MakeCollection(txtCollClass, txtWalkClass, _
  367.                                       txtWalkVar)
  368.     Else
  369.         txtCode.Text = MakeWalker(txtWalkClass, txtCollClass, _
  370.                                   txtCollVar)
  371.     End If
  372. End Sub
  373.  
  374. Private Sub cmdFile_Click()
  375.     Dim result As VbMsgBoxResult, sCollBack As String, sWalkBack As String
  376.     If txtCode = sEmpty Then CreateView
  377.     If txtCollFile = sEmpty Then
  378.         lblStatus.Caption = "Must have collection filename"
  379.         Exit Sub
  380.     ElseIf txtWalkFile = sEmpty Then
  381.         lblStatus.Caption = "Must have walker filename"
  382.         Exit Sub
  383.     End If
  384.     
  385.     If ExistFile(txtCollFile) Then
  386.         result = MsgBox("Files exists: " & txtCollFile & ". Make backup? ", vbYesNoCancel)
  387.         Select Case result
  388.         Case vbYes
  389.             On Error Resume Next
  390.             sCollBack = txtCollFile
  391.             Mid$(sCollBack, Len(sCollBack)) = "K"
  392.             If ExistFile(sCollBack) Then Kill sCollBack
  393.             Name txtCollFile As sCollBack
  394.             On Error GoTo 0
  395.         Case vbNo
  396.             ' Fall through
  397.         Case vbCancel
  398.             Exit Sub
  399.         End Select
  400.     End If
  401.     SaveFileStr txtCollFile, MakeCollection(txtCollClass, txtWalkClass, txtWalkVar)
  402.     
  403.     If ExistFile(txtWalkFile) Then
  404.         result = MsgBox("Files exists: " & txtWalkFile & ". Make backup? ", vbYesNoCancel)
  405.         Select Case result
  406.         Case vbYes
  407.             On Error Resume Next
  408.             sWalkBack = txtWalkFile
  409.             Mid$(sWalkBack, Len(sWalkBack)) = "K"
  410.             If ExistFile(sWalkBack) Then Kill sWalkBack
  411.             Name txtWalkFile As sWalkBack
  412.             On Error GoTo 0
  413.         Case vbNo
  414.             ' Fall through
  415.         Case vbCancel
  416.             Exit Sub
  417.         End Select
  418.     End If
  419.     SaveFileStr txtWalkFile, MakeWalker(txtWalkClass, txtCollClass, txtCollVar)
  420. End Sub
  421.  
  422. Private Function MakeCollection(sCollClass As String, sWalkClass As String, sWalkVar As String) As String
  423.  
  424.     Dim s As String, sCollName  As String
  425.     sCollName = Mid$(sCollClass, 2)
  426.     s = s & "VERSION 1.0 CLASS" & sCrLf & _
  427.             "BEGIN" & sCrLf & _
  428.             "  MultiUse = -1  'True" & sCrLf & _
  429.             "END" & sCrLf & _
  430.             "Attribute VB_Name = " & sQuote2 & sCollClass & sQuote2 & sCrLf & _
  431.             "Attribute VB_GlobalNameSpace = False" & sCrLf & _
  432.             "Attribute VB_Creatable = True" & sCrLf & _
  433.             "Attribute VB_PredeclaredId = False" & sCrLf & _
  434.             "Attribute VB_Exposed = " & IIf(chkCollPublic, "True", "False") & sCrLf & _
  435.             "Option Explicit" & sCrLf & sCrLf
  436.  
  437.     s = s & "' Private data structure" & sCrLf & _
  438.             "'!Private data() As DataType" & sCrLf & sCrLf
  439.  
  440.     s = s & "Private Sub Class_Initialize()" & sCrLf & _
  441.             "    ' Initialize private data" & sCrLf & _
  442.             "    '!data = initval" & sCrLf & _
  443.             "End Sub" & sCrLf & sCrLf
  444.  
  445.     s = s & "' Friend properties to make data structure accessible to walker" & sCrLf & _
  446.             "'!Friend Property Get " & sCollName & "(i As Long) '! As DataType" & sCrLf & _
  447.             "'!    " & sCollName & " = data(i)" & sCrLf & _
  448.             "'!End Property" & sCrLf & sCrLf
  449.     
  450.     s = s & "' NewEnum must have the procedure ID -4 in Procedure Attributes dialog" & sCrLf & _
  451.             "' Create a new data walker object and connect to it" & sCrLf & _
  452.             "Public Function NewEnum() As IEnumVARIANT" & sCrLf & _
  453.             "Attribute NewEnum.VB_UserMemId = -4" & sCrLf & _
  454.             "    ' Create a new iterator object" & sCrLf & _
  455.             "    Dim " & sWalkVar & "walker As " & sWalkClass & sCrLf & _
  456.             "    Set " & sWalkVar & "walker = New " & sWalkClass & sCrLf & _
  457.             "    ' Connect it with collection data" & sCrLf & _
  458.             "    " & sWalkVar & "walker.Attach Me" & sCrLf & _
  459.             "    ' Return it" & sCrLf & _
  460.             "    Set NewEnum = " & sWalkVar & "walker.NewEnum" & sCrLf & _
  461.             "End Function" & sCrLf & sCrLf
  462.  
  463.     s = s & "Public Property Get Count() As Integer" & sCrLf & _
  464.             "    '!Count = curcount" & sCrLf & _
  465.             "End Property" & sCrLf & sCrLf
  466.             
  467.     s = s & "' Default property" & sCrLf & _
  468.             "'!Public Property Get Item(vIndex As Variant) '! As DataType" & sCrLf & _
  469.             "Attribute Item.VB_UserMemId = 0" & sCrLf
  470.             
  471.     Select Case GetOption(optContainer)
  472.     Case ecVariable
  473.     
  474.         s = s & "    '!Item = data(vIndex)" & sCrLf & _
  475.                 "'!End Property" & sCrLf & sCrLf
  476.  
  477.     Case ecObject
  478.     
  479.         s = s & "    '!Set Item = data(vIndex)" & sCrLf & _
  480.                 "'!End Property" & sCrLf & sCrLf
  481.  
  482.     Case ecGeneric
  483.     
  484.         s = s & "    ' Generic containers must check and handle objects" & sCrLf & _
  485.                 "    '!If IsObject(data(vIndex)) Then" & sCrLf & _
  486.                 "    '!    Set Item = data(vIndex)" & sCrLf & _
  487.                 "    '!Else" & sCrLf & _
  488.                 "    '!    Item = data(vIndex)" & sCrLf & _
  489.                 "    '!End If" & sCrLf & _
  490.                 "'!End Property" & sCrLf & sCrLf
  491.  
  492.         s = s & "' Let and Set generally only required for generic containers" & sCrLf & _
  493.                 "Property Let Item(vIndex As Variant, curdataA) '! As DataType)" & sCrLf & _
  494.                 "    '!data(vIndex) = curdataA" & sCrLf & _
  495.                 "End Property" & sCrLf & sCrLf
  496.     
  497.         s = s & "Property Set Item(vIndex As Variant, curdataA) '! As DataType)" & sCrLf & _
  498.                 "    '!Set data(vIndex) = curdataA" & sCrLf & _
  499.                 "End Property" & sCrLf & sCrLf
  500.             
  501.     End Select
  502.  
  503.     s = s & "' Add other collection members such as Add and Remove" & sCrLf & sCrLf
  504.     
  505.     MakeCollection = s
  506.     
  507. End Function
  508.  
  509. Private Function MakeWalker(sWalkClass As String, sCollClass As String, _
  510.                             sCollVar As String) As String
  511.  
  512.     Dim s As String, sCollName As String
  513.     sCollName = Mid$(sCollClass, 2)
  514.     s = s & "VERSION 1.0 CLASS" & sCrLf & _
  515.             "BEGIN" & sCrLf & _
  516.             "  MultiUse = -1  'True" & sCrLf & _
  517.             "END" & sCrLf & _
  518.             "Attribute VB_Name = " & sQuote2 & sWalkClass & sQuote2 & sCrLf & _
  519.             "Attribute VB_GlobalNameSpace = False" & sCrLf & _
  520.             "Attribute VB_Creatable = True" & sCrLf & _
  521.             "Attribute VB_PredeclaredId = False" & sCrLf & _
  522.             "Attribute VB_Exposed = " & IIf(chkWalkPublic, "True", "False") & sCrLf & _
  523.             "Option Explicit" & sCrLf & sCrLf
  524.            
  525.     s = s & "' Implement Basic-friendly version of IEnumVARIANT" & sCrLf & _
  526.             "Implements IVariantWalker" & sCrLf & _
  527.             "' Delegate to class that implements real IEnumVARIANT" & sCrLf & _
  528.             "Private vars As CEnumVariant" & sCrLf & _
  529.             "' Connect back to parent collection" & sCrLf & _
  530.             "Private connect As " & sCollClass & sCrLf & sCrLf
  531.  
  532.     s = s & "' Private state data" & sCrLf & _
  533.             "'!Private iCur As Long" & sCrLf & sCrLf
  534.  
  535.     s = s & "Private Sub Class_Initialize()" & sCrLf & _
  536.             "    ' Initialize position in collection" & sCrLf & _
  537.             "    '!iCur = 0" & sCrLf & _
  538.             "    ' Connect walker to CEnumVariant so it can call methods" & sCrLf & _
  539.             "    Set vars = New CEnumVariant" & sCrLf & _
  540.             "    vars.Attach Me" & sCrLf & _
  541.             "End Sub" & sCrLf & sCrLf
  542.  
  543.     s = s & "' Receive connection from " & sCollClass & sCrLf & _
  544.             "Sub Attach(connectA As " & sCollClass & ")" & sCrLf & _
  545.             "    Set connect = connectA" & sCrLf & _
  546.             "End Sub" & sCrLf & sCrLf
  547.  
  548.     s = s & "' Return IEnumVARIANT (indirectly) to client collection" & sCrLf & _
  549.             "Friend Function NewEnum() As stdole.IEnumVARIANT" & sCrLf & _
  550.             "    Set NewEnum = vars" & sCrLf & _
  551.             "End Function" & sCrLf & sCrLf
  552.  
  553.     s = s & "' Implement IVariantWalker methods" & sCrLf & _
  554.             "Private Function IVariantWalker_More(v As Variant) As Boolean" & sCrLf & _
  555.             "    ' Move to next element" & sCrLf & _
  556.             "    '!iCur = iCur + 1" & sCrLf & _
  557.             "    ' If more data, return True and update data" & sCrLf & _
  558.             "    '!If iCur <= connect.Count Then" & sCrLf & _
  559.             "        '!IVariantWalker_More = True" & sCrLf
  560.  
  561.     Select Case GetOption(optContainer)
  562.     Case ecVariable
  563.     
  564.         s = s & "        '!v = connect." & sCollName & "(iCur)" & sCrLf
  565.  
  566.     Case ecObject
  567.     
  568.         s = s & "        '!Set v = connect." & sCollName & "(iCur)" & sCrLf
  569.  
  570.     Case ecGeneric
  571.     
  572.         s = s & "        '!If IsObject(connect." & sCollName & "(iCur)) Then" & sCrLf & _
  573.                 "        '!    Set v = connect." & sCollName & "(iCur)" & sCrLf & _
  574.                 "        '!Else" & sCrLf & _
  575.                 "        '!    v = connect." & sCollName & "(iCur)" & sCrLf & _
  576.                 "        '!End If" & sCrLf
  577.     End Select
  578.     
  579.     s = s & "    '!End If" & sCrLf & _
  580.             "End Function" & sCrLf & sCrLf
  581.  
  582.     s = s & "Private Sub IVariantWalker_Reset()" & sCrLf & _
  583.             "    ' Move to first element" & sCrLf & _
  584.             "    '!iCur = 0" & sCrLf & _
  585.             "End Sub" & sCrLf & sCrLf
  586.  
  587.     s = s & "Private Sub IVariantWalker_Skip(c as Long)" & sCrLf & _
  588.             "    ' Skip a given number of elements" & sCrLf & _
  589.             "    '!iCur = iCur + c" & sCrLf & _
  590.             "End Sub" & sCrLf & sCrLf
  591.             
  592.     MakeWalker = s
  593.     
  594. End Function
  595.  
  596.